perm filename BBASE.MF[MF,DEK] blob sn#753914 filedate 1984-05-18 generic text, type T, neo UTF8
delimiters ();

ppi=722.909;	% pixels per inch, on the APS (change this for other devices!)
in=ppi;		% conversion factor from inches to pixels
cm=ppi/2.54;	% conversion factor from centimeters to pixels
pt=ppi/72.27;	% conversion factor from points to pixels

hppp:=pt;		% horizontal pixels per point
vppp:=pt;		% vertical pixels per point

smoothing:=1; autorounding:=2;	% this adjusts curves to the raster
proofing:=1; % this says we're expecting to make proofsheets

vardef z@#=(x@#,y@#) enddef; % this defines the z convention for points
vardef dz@# = (dx@#,dy@#) enddef;

edges e; e=nulledges; % this initializes an empty set of pixels
pen defaultpen; defaultpen=pencircle; % and this initializes a unit pen

def fill expr c = addto e contour c withweight 1 enddef;
def erase expr c = addto e contour c withweight -1 enddef;
def draw expr p = addto e doublepath p withpen defaultpen enddef;

def showit = display e on window enddef;
def clearit = e:=nulledges enddef;
def shipit = shipout e enddef;
def cullit = cull e by (-9,1) enddef;

vardef pos@#(expr length,theta) =
	z@#=.5[z@#l,z@#r];
	z@#r-z@#l=(length,0) rotated theta enddef;
def stroke(suffix $,$$)(expr t,lt,rt) =
	fill z$l
	 if not unknown dz$: {dz$} fi
	 if t<>0: ..lt[ t[z$l,z$$l],t[z$,z$$] ]{z$$l-z$l} fi
	 .. z$$l
	  if not unknown dz$$: {dz$$} fi
	& z$$l..z$$r
	& z$$r
	  if not unknown dz$$: {-dz$$} fi
	 if t<>0: ..rt[ t[z$r,z$$r],t[z$,z$$] ]{z$r-z$$r} fi
	 .. z$r
	 if not unknown dz$: {-dz$} fi
	& z$r..z$l & cycle;
	showit; enddef;
def curve(suffix $,$$,$$$) =
	fill z$l
	 if not unknown dz$: {dz$} fi
	.. z$$l{if unknown dz$$: z$$$l-z$l else: dz$$ fi}
	.. z$$$l
	 if not unknown dz$$$: {dz$$$} fi
	& z$$$l..z$$$r
	& z$$$r
	 if not unknown dz$$$: {-dz$$$} fi
	.. z$$r{if unknown dz$$: z$r-z$$$r else: -dz$$ fi}
	.. z$r
	 if not unknown dz$: {-dz$} fi
	& z$r..z$l & cycle;
	showit; enddef;

def autolabel = makelabel(" 5") enddef;
def makelabel(expr s)(text t) =
	forsuffixes $:=t:
	if not unknown z$:
	special s&str$; numspecial x$; numspecial y$; fi endfor enddef;
def proofrule(expr a,b) =
	special "rule"; numspecial xpart a; numspecial ypart a;
	numspecial xpart b; numspecial ypart b enddef;
def labelpos(text t) =
	if proofing>0:
	forsuffixes $:=t: autolabel($l,$r,$); endfor fi enddef;

def clear =
	numeric x[],y[],x[]l,y[]l,x[]r,y[]r,dx[],dy[];
	e:=nulledges;
enddef;

def setwidth expr x =
	chardw:=x;
	numeric w; w=x;
	charwd:=x/pt;
	proofrule((-10,0),(w+10,0));
enddef;
def setheight expr x = charht:=x/pt;
	numeric h; h=x;
	proofrule((0,h),(w,h));
enddef;
def setdepth expr x = chardp:=x/pt;
	numeric d; d=x;
	proofrule((0,-d),(w,d));
	proofrule((0,-d),(0,h));
	proofrule((w,-d),(w,h));
enddef;

vardef test.N.@# = testit(@,@#) enddef;
vardef test.M.@# = testit(@,@#) enddef;
vardef test.S.@# = testit(@,@#) enddef;

vardef testit(suffix $,#) =
 begingroup clear; h:=$.height; w:=#.width;
 chardw:=w; charwd:=w/pt; charht:=h/pt;
 charcode := ord str # +
  (if str $ = "N": + 1 elseif str $ = "S": + 2 else: 0 fi);
 proofrule ((0,0),(w,0)); proofrule ((0,h),(w,h));
 proofrule ((0,0),(0,h)); proofrule ((w,0),(w,h));
 char.$.#; showit; shipit; endgroup enddef;

openwindow 1 from (0,0) to (450,600) at (-20,300); window:=1;

def sunrules =
	def proofrule(expr a,b)=draw a..b withpen rulepen enddef;
	pen rulepen; rulepen = pencircle scaled 2;
enddef;